home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / strings.swg / 0087_Longints in Pascal.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  3.1 KB  |  140 lines
  1.  
  2.   type
  3.     long = array[0..3] of byte;   {defines the fake-longint type}
  4.     string8 = string[8];
  5.  
  6.   {translate the significant portion of a real into a long var}
  7.   procedure real2long(r:real; var l:long; var e:boolean);
  8.   type
  9.     string8   = string[8];
  10.     string32  = string[32];
  11.   var
  12.     s : string32;
  13.  
  14.     function power(b:real; x:integer; var e:boolean): real;
  15.     begin
  16.       if b > 0 then 
  17.         power:= exp(x * ln(b))
  18.       else halt;
  19.     end;
  20.  
  21.     {translate the significant portion of a real into a binary string32}
  22.     procedure intreal2binstr(r:real; var s:string32; var e:boolean);
  23.     var
  24.       i : integer;
  25.       m : real;
  26.       p : real;
  27.     begin
  28.       e:= false;
  29.       if (r > power(2,32,e)-1) then begin
  30.         e:= true;
  31.         exit;
  32.       end;
  33.       s:= '';
  34.       for i:= 31 downto 1 do begin
  35.         p:= power(2,i,e);
  36.         m:= int(r/p);
  37.         r:= r - (m * p);
  38.         if (int(m) = 0)  then s:= s + '0'
  39.                          else s:= s + '1';
  40.       end;
  41.       m:= int(r);
  42.       r:= r - m;
  43.       if (int(m) = 0) then s:= s + '0'
  44.                       else s:= s + '1';
  45.     end; 
  46.  
  47.     {translate a binary string32 into a long variable}
  48.     procedure binstr2long(s: string32; var l:long; var e:boolean);
  49.     var
  50.       i : integer;
  51.       w : string[8];
  52.       b : byte;
  53.   
  54.       {translate a binary string8 into a byte}
  55.       procedure binstr2byte(s:string8; var y:byte; var e:boolean);
  56.       var
  57.         i   : integer;
  58.         v   : integer;
  59.         c   : integer;
  60.         b   : byte;
  61.       begin
  62.         y:= 0;
  63.         for i:= 1 to 8 do begin
  64.           val(s[i],v,c);
  65.           e:= not(c = 0);
  66.           if e then exit;
  67.           b:= v * trunc(power(2,(8-i),e));
  68.           y:= y or b;
  69.         end;
  70.       end;
  71.  
  72.     begin  {binstr2long}
  73.       for i:= 0 to 3 do begin
  74.         w:= copy(s,(i*8)+1,8);
  75.         binstr2byte(w,b,e);
  76.         l[3 - i]:= b;
  77.       end;
  78.     end;
  79.  
  80.   begin {real2long}
  81.     intreal2binstr(r,s,e);
  82.     if e then exit;
  83.     binstr2long(s,l,e);
  84.     if e then exit;
  85.  end;
  86.  
  87.   {translate a string8 (a number in hex notation) into a long variable} 
  88.   procedure str2long(s:string8; var l:long; var e: boolean);
  89.   var
  90.     i : integer;
  91.     c : integer;
  92.     v : integer;
  93.     sb : array[0..3] of string[3];
  94.   begin
  95.     for i:= 0 to 3 do begin
  96.       sb[i]:= '$' + copy(s,(7-(i*2)),2);
  97.       val(sb[i],v,c);
  98.       e:= not(c = 0);
  99.       if e then exit;
  100.       l[i]:= v;
  101.     end;
  102.   end;
  103.  
  104.   {translate an integer into a long variable}
  105.   procedure int2long(i:integer; var l: long);
  106.   begin
  107.     fillchar(l,sizeof(l),0);
  108.     move(i,l,2);
  109.   end;
  110.  
  111.   {"shr 8" for long variables}
  112.   procedure shr8(var a,b: long);
  113.   var
  114.     i : integer;
  115.   begin
  116.     for i:= 0 to 2 do
  117.       b[i]:= a[(i+1)];
  118.     b[3]:= 0;
  119.   end;
  120.  
  121.   {"xor" for long variables}
  122.   procedure xorl(var a,b,c : long);
  123.   var
  124.     i : integer;
  125.   begin
  126.     for i:= 0 to 3 do
  127.       c[i]:= a[i] xor b[i];
  128.   end;
  129.  
  130.   {"and" for long variables}
  131.   procedure andl(var a,b,c : long);
  132.   var
  133.     i : integer;
  134.   begin
  135.     for i:= 0 to 3 do
  136.       c[i]:= a[i] and b[i];
  137.   end;
  138.  
  139. BEGIN
  140. END.